Data Science for Business

class: title-slide

# ER014 - Data Science & Strategy for Business

## PVA2

### Teil 2: Deskriptive Regressionsanalyse

<br>
<br>
<br>
<br>
<br>
<br>
<br>
### FS 2024
<br>
### Prof. Dr. Jörg Schoder
.mycontacts[
<svg aria-hidden="true" role="img" viewBox="0 0 496 512" style="height:1em;width:0.97em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M165.9 397.4c0 2-2.3 3.6-5.2 3.6-3.3.3-5.6-1.3-5.6-3.6 0-2 2.3-3.6 5.2-3.6 3-.3 5.6 1.3 5.6 3.6zm-31.1-4.5c-.7 2 1.3 4.3 4.3 4.9 2.6 1 5.6 0 6.2-2s-1.3-4.3-4.3-5.2c-2.6-.7-5.5.3-6.2 2.3zm44.2-1.7c-2.9.7-4.9 2.6-4.6 4.9.3 2 2.9 3.3 5.9 2.6 2.9-.7 4.9-2.6 4.6-4.6-.3-1.9-3-3.2-5.9-2.9zM244.8 8C106.1 8 0 113.3 0 252c0 110.9 69.8 205.8 169.5 239.2 12.8 2.3 17.3-5.6 17.3-12.1 0-6.2-.3-40.4-.3-61.4 0 0-70 15-84.7-29.8 0 0-11.4-29.1-27.8-36.6 0 0-22.9-15.7 1.6-15.4 0 0 24.9 2 38.6 25.8 21.9 38.6 58.6 27.5 72.9 20.9 2.3-16 8.8-27.1 16-33.7-55.9-6.2-112.3-14.3-112.3-110.5 0-27.5 7.6-41.3 23.6-58.9-2.6-6.5-11.1-33.3 2.6-67.9 20.9-6.5 69 27 69 27 20-5.6 41.5-8.5 62.8-8.5s42.8 2.9 62.8 8.5c0 0 48.1-33.6 69-27 13.7 34.7 5.2 61.4 2.6 67.9 16 17.7 25.8 31.5 25.8 58.9 0 96.5-58.9 104.2-114.8 110.5 9.2 7.9 17 22.9 17 46.4 0 33.7-.3 75.4-.3 83.6 0 6.5 4.6 14.4 17.3 12.1C428.2 457.8 496 362.9 496 252 496 113.3 383.5 8 244.8 8zM97.2 352.9c-1.3 1-1 3.3.7 5.2 1.6 1.6 3.9 2.3 5.2 1 1.3-1 1-3.3-.7-5.2-1.6-1.6-3.9-2.3-5.2-1zm-10.8-8.1c-.7 1.3.3 2.9 2.3 3.9 1.6 1 3.6.7 4.3-.7.7-1.3-.3-2.9-2.3-3.9-2-.6-3.6-.3-4.3.7zm32.4 35.6c-1.6 1.3-1 4.3 1.3 6.2 2.3 2.3 5.2 2.6 6.5 1 1.3-1.3.7-4.3-1.3-6.2-2.2-2.3-5.2-2.6-6.5-1zm-11.4-14.7c-1.6 1-1.6 3.6 0 5.9 1.6 2.3 4.3 3.3 5.6 2.3 1.6-1.3 1.6-3.9 0-6.2-1.4-2.3-4-3.3-5.6-2z"/></svg> @FFHS-EconomicResearch
<svg aria-hidden="true" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M416 32H31.9C14.3 32 0 46.5 0 64.3v383.4C0 465.5 14.3 480 31.9 480H416c17.6 0 32-14.5 32-32.3V64.3c0-17.8-14.4-32.3-32-32.3zM135.4 416H69V202.2h66.5V416zm-33.2-243c-21.3 0-38.5-17.3-38.5-38.5S80.9 96 102.2 96c21.2 0 38.5 17.3 38.5 38.5 0 21.3-17.2 38.5-38.5 38.5zm282.1 243h-66.4V312c0-24.8-.5-56.7-34.5-56.7-34.6 0-39.9 27-39.9 54.9V416h-66.4V202.2h63.7v29.2h.9c8.9-16.8 30.6-34.5 62.9-34.5 67.2 0 79.7 44.3 79.7 101.9V416z"/></svg> @jfschoder
]

---
layout: true

<div style="position: absolute;left:400px;bottom:10px;font-size:9px"><svg aria-hidden="true" role="img" viewBox="0 0 496 512" style="height:1em;width:0.97em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M245.83 214.87l-33.22 17.28c-9.43-19.58-25.24-19.93-27.46-19.93-22.13 0-33.22 14.61-33.22 43.84 0 23.57 9.21 43.84 33.22 43.84 14.47 0 24.65-7.09 30.57-21.26l30.55 15.5c-6.17 11.51-25.69 38.98-65.1 38.98-22.6 0-73.96-10.32-73.96-77.05 0-58.69 43-77.06 72.63-77.06 30.72-.01 52.7 11.95 65.99 35.86zm143.05 0l-32.78 17.28c-9.5-19.77-25.72-19.93-27.9-19.93-22.14 0-33.22 14.61-33.22 43.84 0 23.55 9.23 43.84 33.22 43.84 14.45 0 24.65-7.09 30.54-21.26l31 15.5c-2.1 3.75-21.39 38.98-65.09 38.98-22.69 0-73.96-9.87-73.96-77.05 0-58.67 42.97-77.06 72.63-77.06 30.71-.01 52.58 11.95 65.56 35.86zM247.56 8.05C104.74 8.05 0 123.11 0 256.05c0 138.49 113.6 248 247.56 248 129.93 0 248.44-100.87 248.44-248 0-137.87-106.62-248-248.44-248zm.87 450.81c-112.54 0-203.7-93.04-203.7-202.81 0-105.42 85.43-203.27 203.72-203.27 112.53 0 202.82 89.46 202.82 203.26-.01 121.69-99.68 202.82-202.84 202.82z"/></svg>Prof. Dr. Jörg Schoder</div>

---
name: agenda
class: left

.blockquote[Agenda]

## Empirische Regressionsanalyse

* Deskriptive und explorative Datenanalyse

* Methode der Kleinsten Quadrate (KQ-Methode)

* Einfache (deskriptive) Regressionsanalyse

* Multiple (deskriptive) Regressionanalyse

---
class: left

.blockquote[Deskriptive und explorative Datenanalyse]

## Explorative Datenanalyse und Erkennung von Mustern

???

* Ein Tool, um im wahrsten Sinne des Wortes ein Bild von den Daten zu bekommen ist die EDA

* Erlaubt uns bspw. schnell, lineare und nicht-lineare Zusammenhänge als Muster zu erkennen

* Deshalbt sollte jde Regressionsanalyse mit einer EDA beginnen

---
class: left

.blockquote[Deskriptive und explorative Datenanalyse]

## Wahrnehmung und Kausalität

.panelset[
.panel[.panel-name[Grauton A vs. B]
<iframe src="https://persci.mit.edu/gallery/checkershadow" width="100%" height="420px" data-external="1"></iframe>
]
.panel[.panel-name[Beweis]
<img src="data:image/png;base64,#https://persci.mit.edu/wp-content/uploads/checkershadow_double_med-1024x398.jpg" width="100%" style="display: block; margin: auto;" />
]
]

???

[Stocker, Kap 10](https://www.uibk.ac.at/econometrics/einf/kap10.pdf)

* Aber: Mustererkennung bedeutet nicht, dass es auch kausale Zusammenhänge sind!

* Charts legen Zusammenhang nahe, der vielleiht in Wahrheit gar nicht existiert.

* Wahrnehmung kann täuschen. Kant: Kausalität als a priori gegebene Kategorie bildet, die notwendig ist um Erfahrung überhaupt erst machen zu können. 
  * Kausalität existiert demnach nicht unabhängig von unserer Wahrnehmung, sondern wird gewissermaßen "in die Realität hineinprojeziert" und ist in diesem Sinne eine Vorbedingung fur unsere Wahrnehmung.
  * In dieser Hinsicht war Kant noch radikaler als Hume, für ihn gehört Kausalität
gewissermaßen zur inneren Struktur der Erkenntnis

* Diese Ideen wurden später von verschiedenen Richtungen des Konstruktivismus aufgegriffen, die davon ausgehen, dass die empfundene Realität von den Individuen
selbst durch den Vorgang des Erkennens konstruiert wird

* Beispiel: Unser Gehirn analysiert das Schachbrett scheinbar ohne unser aktives Zutun
  * und schließt aus der Anordnung und der unscharfen Kontur, dass B im Schatten
liegt, also dunkler sein sollte. 
  * Um diesen Effekt zu korrigieren und die Kontrast auszugleichen "rechnet" unser Gehirn diesen Effekt heraus, weshalb uns B heller als A erscheint

---
class: left

.blockquote[Deskriptive und explorative Datenanalyse]

## Elemente explorativer Datenanalyse

* Hervorhebung der inhaltlichen Bedeutung der Daten. Es geht primär um ein substanzielles
Verständnis von Variablen und deren möglichen Zusammenhängen

* Betonung der grafischen Darstellung und Inspektion von Variablen bzw. Datenmengen

* Schwerpunkt liegt auf der versuchsweisen Modellbildung und Hypothesengenerierung
in einem iterativen Prozess der Modellspezifikation und Modellneuspezifikation

* Ausgangspunkte sind Skepsis, Flexibilität und Sparsamkeit bezüglich der anzuwendenden statistischen Methoden

???

<a name=cite-stoetzer_regressionsanalyse_2020></a>[Stoetzer (2020b)](#bib-stoetzer_regressionsanalyse_2020), S. 3

---
class: left

.blockquote[Deskriptive und explorative Datenanalyse]

## Explorative Datenanalyse mit einer Zeile R-Code

.pull-left[

```r
# Import data -----
my_in_file <- "autos_(StockerUIBK)_20240414.csv"
tbl_autos <- read_csv2(xfun::from_root("data","raw",my_in_file))
# GGally-Matrixplot -----
library(GGally)
tbl_autos %>% ggpairs() +
                  theme_light()
```

]
.pull-right[
![](data:image/png;base64,#02_DescriptiveRegression_files/figure-html/EDA-Autos-1.png)
]

---
class: inverse, center, middle

## Methode der kleinsten Quadrate

.blockquote[Einfache Regression]

.blockquote[Multiple Regression]

---
class: left

.blockquote[Einfache Regression]

## Grundidee: Zusammenhänge mit Funktionen beschreiben

* Einfach(st)er Fall: 1 Regressand `$Y$`, 1 Regressor `$X$` (bivariater Fall)

--
* "Regression von Y auf X": (y-x-Regression `$\hat{y}=f(x)$`)

--
* `$f(x)$`?

--
  * Linear: `$y=b_1+b_2x$`
  
      * `$b_1$`: Interzept/Konstante
      * `$b_2$`: Steigungskoeffizient

--
  * Parabel: `$y=b_1+b_2x+b_3x^2$`

--
  * Potenzfunktion: `$y=b_1x^{b_2}$`

--
  * Exponentialfunktion: `$y=b_1b_2^x$`

--
  * logistische Funktion: `$y=\frac{k}{1+e^{b_1+b_2x}},~b_2<0.$`

--
  * ...

???

* Im Folgenden sei `$X$` der Regressor (unabhängige Variable) und `$Y$` der Regressand (abhängige Variable) bzw. "Regression von Y auf X": (y-x-Regression `$\hat{y}=f(x)$`).

* Umgekehrt `$\hat{x}=h(y)$` als Regression von X auf Y (x-y-Regression).

* wir schauen uns den einfachsten Fall an, eine lineare Gleichung, die hat nur 2 Koeffizienten...

---
class: left

.blockquote[Einfache Regression]

## Methode der kleinsten Quadrate (Ordinary Least Squares, OLS)

* Geradengleichung:

`$$\begin{aligned}[t]
	y_i&=\underbrace{b_1+b_2x_i}_{\mbox{systematische Komponente}}+\underbrace{e_i}_{\mbox{unsystematische Komponente}}\\
	&=\underbrace{\hat{y}}_{\mbox{Regressionsfunktion}}+\underbrace{e_i}_{\mbox{Residuum}}
\end{aligned}$$`

--
`$$\iff e_i = y_i - \hat{y}_i ~\mbox{für}~i = 1,\dots, n$$`

.blockquote[
<svg aria-hidden="true" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M0 80V229.5c0 17 6.7 33.3 18.7 45.3l176 176c25 25 65.5 25 90.5 0L418.7 317.3c25-25 25-65.5 0-90.5l-176-176c-12-12-28.3-18.7-45.3-18.7H48C21.5 32 0 53.5 0 80zm112 32a32 32 0 1 1 0 64 32 32 0 1 1 0-64z"/></svg>	Differenzen zwischen beobachteten Werten `$y_i$` und den Werten auf der Regressionsgeraden `$\hat{y_i}$` heißen **Residuen** (von Residualgröße, engl. residuals) `$e_i$`. 
]

* Idee: 
  * Wähle die Gerade, die von Streuung der beobachteten `$y$`-Werte möglichst viel "erklärt"
  * Minimiere den Anteil der unsystematischen Komponente `$(e)$` (nicht erklärte Streuung)

???

* `$\hat{y}$` (lies: "y Dach"):
  * **Regressionsfunktion** `$(\hat{y}=b_1+b_2x_i)$` bildet nicht die tatsächlichen Wertepaare ($x_i,y_i$) ab,...
  * ... *sondern ordnet jedem beobachteten* x-Wert einen *"durchschnittlichen" y-Wert ($\hat{y}$)} zu
  * wobei `$\hat{y}$` *auf der Regressionsfunktion* liegt.

---
class: left

.blockquote[Einfache Regression]

## OLS-Regressionsgerade grafisch bestimmen

???

Obs! Die Regressionsgerade ist diejenige Gerade, welche die Summe der quadrierten Vorhersagefehler (Residuen) minimiert.

---
class: left

.blockquote[Einfache Regression]

## Regressionsgerade analytisch ermitteln

* Residuen als nicht erklärte Streuung

* Optimierungsproblem:
	
`$$\begin{equation}
\min_{b_1,b_2}\sum_{i=1}^ne_i^2=\sum_{i=1}^n(y_i-\hat{y})^2=\sum_{i=1}^n(y_i-b_1-b_2x_i)^2
\end{equation}$$`

* Bedingungen erster Ordnung:

`$$\begin{equation} 
\frac{\partial\sum_ie_i^2}{\partial b_1}=-2\sum_i(y_i-b_1-b_2x_i)=-2\sum_i e_i\stackrel{!}{=}0~~~~~~
(1)
\end{equation}$$`

`$$\begin{equation} 
\frac{\partial\sum_ie_i^2}{\partial b_2}=-2\sum_i(y_i-b_1-b_2x_i)x_i=-2\sum_i x_ie_i\stackrel{!}{=}0~~~~~~
(2)
\end{equation}$$`

---
class: left

.blockquote[Einfache Regression]

## Regressionsgerade analytisch ermitteln (cont'd)

* Umstellung von Gleichung (1) liefert *Bestimmungsgleichung für* `$b_1$`:

`$$\begin{equation}
\sum y_i=n b_1+b_2\sum x_i\implies b_1=\bar{y}-b_2\bar{x}~~~~~~
(3)
\end{equation}$$`

* Einsetzen von (3) in (2) liefert *Bestimmungsgleichung für* `$b_2$`:

`$$\begin{equation*}
b_2=\frac{\sum_i(x_i-\bar{x})(y_i-\bar{y})}{\sum_i(x_i-\bar{x})^2} \iff 	b_2=\frac{\frac{1}{n}\sum_i(x_i-\bar{x})(y_i-\bar{y})}{\frac{1}{n}\sum_i(x_i-\bar{x})^2}
\end{equation*}$$`

* Damit:

`$$\begin{equation}
b_2=\frac{s_{y,x}}{s^2_x}
\end{equation}$$`

---
class: left

.blockquote[Multiple Regression]

## Zwei (numerische) Regressoren

???

---
class: left

.blockquote[Multiple Regression]

## Mehr als zwei  Regressoren

* Von der Geradengleichung zur Linearkombination:

`$$y_i=b_{i1}x_{i1}+b_{i2}x_{i2}+b_{i3}x_{i3}+\dots+b_{ik}x_{ik}+e_i$$`

* Matrizendarstellung:

`$$\begin{pmatrix}
y_1 \\
y_2 \\
\vdots \\
y_i 
\end{pmatrix}
=
\begin{pmatrix}
x_{1,1} & x_{1,2} & \cdots & x_{1,k} \\
x_{2,1} & x_{2,2} & \cdots & x_{2,k} \\
\vdots  & \vdots  & \ddots & \vdots  \\
x_{i,1} & x_{i,2} & \cdots & x_{i,k} 
\end{pmatrix}\cdot
\begin{pmatrix}
b_1 \\
b_2 \\
\vdots \\
b_k
\end{pmatrix}
+
\begin{pmatrix}
e_1 \\
e_2 \\
\vdots \\
e_i
\end{pmatrix}$$`

* Kompakte Matrizen-Schreibweise:

`$$\textbf{y}=\textbf{X}\cdot b+e$$`

---
class: left

.blockquote[Multiple Regression]

## Optimierungsproblem

* Analog zur linearen Einfachregression sollen die quadrierten Residuen minimiert werden:

`$$\begin{eqnarray}\min_\beta(e'e)&=&\min_\beta(y-X\beta)'(y-X\beta)\\
&=&\min_\beta[y'y-2\beta'X'y+\beta'X'X\beta]\,
\end{eqnarray}$$`

* Bedingung erster Ordnung (FOC):

`$$\frac{\partial(e'e)}{\partial b}=-2X'y+2X'X b\stackrel{!}{=}0$$`

* Damit folgt für die Koeffizienten:

`$$b=(X'X)^{-1}X'y$$`

???

* Ein wesentlicher Teil des Charmes linearer Regressionsmodelle liegt in der einfachen
Interpretation der Koeffizienten als marginale Effekte, denn **aufgrund der linearen
Funktionsform sind die Regressionskoeffizienten** einfach die **partiellen Ableitungen**
und können als solche interpretiert werden.

* Das einzig Neue, was dazukommt, ist die ceteris paribus Interpretation.

vgl. [Stocker, Kap. 2, S. 41](https://www.uibk.ac.at/econometrics/einf/kap02_ols.pdf)

---
class: inverse, center, middle

## Einfache (deskriptive) Regressionsanalyse

.blockquote[Bedingte Mittelwerte]

.blockquote[Bestimmtheitsmaß]

.blockquote[Ein kategorialer Regressor]

---
class: left

.blockquote[Bedingte Mittelwerte]

## Beispiel Autodaten: Kennzahlen

* Arithmetischer Mittelwert und Median:

```r
tbl_autos %>% 
      summarise(d_alter=mean(Alter),
                d_preis=mean(Preis),
                med_alter=median(Alter),
                med_preis=median(Preis),
                r = cor(Alter, Preis))
```

```
## # A tibble: 1 × 5
##   d_alter d_preis med_alter med_preis      r
##     <dbl>   <dbl>     <dbl>     <dbl>  <dbl>
## 1    2.47   16542      2.28     17050 -0.932
```

???

```r
library(skimr)
tbl_autos %>% 
  select(Alter, Preis) %>% skim()
```

Table: Data summary

|                         |           |
|:------------------------|:----------|
|Name                     |Piped data |
|Number of rows           |40         |
|Number of columns        |2          |
|_______________________  |           |
|Column type frequency:   |           |
|numeric                  |2          |
|________________________ |           |
|Group variables          |None       |

**Variable type: numeric**

|skim_variable | n_missing| complete_rate|     mean|      sd|      p0|      p25|      p50|     p75|     p100|hist  |
|:-------------|---------:|-------------:|--------:|-------:|-------:|--------:|--------:|-------:|--------:|:-----|
|Alter         |         0|             1|     2.47|    1.35|    0.17|     1.55|     2.28|     3.3|     5.49|▅▇▆▅▂ |
|Preis         |         0|             1| 16542.00| 3822.29| 6700.00| 14417.50| 17050.00| 18890.0| 24000.00|▂▂▆▇▂ |

---
class: left

.blockquote[Bedingte Mittelwerte]

## Beispiel Autodaten: Regressionsgerade

.pull-left[

```r
tbl_autos %>% 
          ggplot(aes(x=Alter,y=Preis)) + 
              geom_point() + theme_light() + 
              geom_smooth(method = "lm", se = FALSE) +
              scale_x_continuous(limits=c(0,6),breaks=seq(0, 5, 1)) +
              scale_y_continuous(limits=c(0,26000),breaks=seq(0, 25000, 5000)) + 
              labs(x="Alter (in Jahren)",y="Preis",title="Gebrauchtwagen")
```
]
.pull-right[
![](data:image/png;base64,#02_DescriptiveRegression_files/figure-html/Reg-Autos-1.png)
]

---
class: left

.blockquote[Bedingte Mittelwerte]

## Beispiel Autodaten: Koeffizienten ermitteln

.pull-left[

```r
model <- tbl_autos %>% 
                lm(Preis~Alter,.)
library(broom)
tidy(model) %>% 
  select(term,estimate)
```

```
## # A tibble: 2 × 2
##   term        estimate
##   <chr>          <dbl>
## 1 (Intercept)   23057.
## 2 Alter         -2636.
```
]
.pull-right[

```r
library(moderndive)
get_regression_table(model) %>% 
                select(term,estimate)
```

```
## # A tibble: 2 × 2
##   term      estimate
##   <chr>        <dbl>
## 1 intercept   23057.
## 2 Alter       -2636.
```
]

---
class: left

.blockquote[Bedingte Mittelwerte]

## Beispiel Autodaten: Koeffizienten interpretieren

* Regressionsgerade

`$$\begin{eqnarray}\hat{y_i}&=&b_1+b_2\cdot x_i\\
\widehat{\mbox{Preis_i}}&=&b_1 + b_2\cdot \mbox{Alter}\\
&=&23056-2635\cdot Alter_i\\
\end{eqnarray}$$`

* Interpretation Intercept `$(b_1)$`: Durchschnittspreis für neues Autos

```r
dp0 <- tbl_autos %>% filter(Alter<.5) %>% 
          summarise(d_preis_neuwagen=mean(Preis))
dp0
```

```
## # A tibble: 1 × 1
##   d_preis_neuwagen
##              <dbl>
## 1           23567.
```

---
class: left

.blockquote[Bedingte Mittelwerte]

## Beispiel Autodaten: Steigungskoeffizient interpretieren

* Interpretation Steigung `$(b_2)$`: Mit jedem zusätzlichen Jahr verringert sich der Wert des Fahrzeugs **im Durchschnitt** um -2635.67 Geldeinheiten.

* Ermittlung des **Durchschnittspreis** eines 2-jährigen Autos mittels Modell:

```r
dp2 <- pull(dp0)+tidy(model)$estimate[2]*2
dp2
```

```
## [1] 18295.33
```

* Vergleich mit den Daten

```r
tbl_autos %>% filter(Alter>1.5&Alter<2.5) %>% 
          summarise(d_preis_neuwagen=mean(Preis)) %>% pull()
```

```
## [1] 17695.83
```

???
[Stocker](https://www.uibk.ac.at/econometrics/einf/kap02_ols.pdf), S. 24

Intuitiv können wir uns also

* die gefitteten Werte `$y_b$` (auf der Regressionsgeraden) als lineare Approximation an die bedingten Mittelwerte vorstellen.

* Wir werden diese Interpretation später weiter vertiefen, wenn wir Dummy Variablen diskutieren.

* Hier dient sie v.a. als *Vorbereitung auf die stochastische Regressionsanalyse*, in deren Rahmen wir die `$y_b$` ganz ähnlich als **lineare Approximation an die bedingten
Erwartungswerte** interpretieren werden.

---
class: left

.blockquote[Bestimmtheitsmaß]

## Varianzzerlegung

.quelle[Bildquelle: [<a name=cite-stocker_grundlagen_nodate></a>[Stocker ()](#bib-stocker_grundlagen_nodate), S. 33.](https://www.uibk.ac.at/econometrics/einf/kap02_ols.pdf)]

---
class: left

.blockquote[Bestimmtheitsmaß]

## Erklärte vs. nicht erklärte Streuung

* Abweichung einer einzelnen Beobachtung vom Mittelwert `$\bar{y}$`:

`$$\begin{equation}
  y_i-\bar{y}=(\hat{y}_i-\bar{y})+(y_i-\hat{y}_i)~~~~~~(1)
\end{equation}$$`

* Ermittlung der **Gesamtstreuung** von `$y$` um den Mittelwert `$\bar{y}$` durch quadrieren von Gleichung (1) und aufsummieren über alle Beobachtungen sowie diverse Umformungen:

`$$\begin{equation*}
\sum_i(y_i-\bar{y})^2=\sum_i(\hat{y}_i-\bar{y})^2+\sum_i(y_i-\hat{y})^2
\end{equation*}$$`
bzw.
`$$\begin{equation*}
	\underbrace{\sum_i(y_i-\bar{y})^2}_{\mbox{TSS}}=\underbrace{\sum_i(\hat{y}_i-\bar{y})^2}_{\mbox{ESS}}+\underbrace{\sum_i e_i^2}_{\mbox{SSR}}
\end{equation*}$$`

---
class: left

.blockquote[Bestimmtheitsmaß]

## Bestimmtheitsmaß und Wertebereich

.blockquote[
<svg aria-hidden="true" role="img" viewBox="0 0 448 512" style="height:1em;width:0.88em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M0 80V229.5c0 17 6.7 33.3 18.7 45.3l176 176c25 25 65.5 25 90.5 0L418.7 317.3c25-25 25-65.5 0-90.5l-176-176c-12-12-28.3-18.7-45.3-18.7H48C21.5 32 0 53.5 0 80zm112 32a32 32 0 1 1 0 64 32 32 0 1 1 0-64z"/></svg> Das Bestimmtheitsmaß `$R^2$` (engl. R squared) ist definiert als Anteil der durch die Regressionsgerade erklärten Streuung (ESS) an der gesamten Streuung (TSS):

`$$\begin{equation*}
	R^2 =\frac{\mbox{ESS}}{\mbox{TSS}}=\frac{\mbox{TSS}-\mbox{SSR}}{TSS}=1-\frac{\mbox{SSR}}{TSS}=1-\frac{\sum_i e_i^2}{\sum_i(y_i-\bar{y})^2}
\end{equation*}$$`

]

???

* Die Gesamtstreuung ("Total Sum Squared", TSS) ergibt sich als Summe aus erklärter Streuung ("Explained Sum Squared", ESS) und nicht erklärter Streuung ("Sum of Squared Residuals", SSR).
* Obs! Für Regressionsgleichungen mit Interzept gilt: `$0\leq R^2\leq 1$`.

---
class: left

.blockquote[Bestimmtheitsmaß]

## Bestimmtheitsmaß in R: Residuen ermitteln

```r
regression_points <- get_regression_points(model)
regression_points %>% 
  head(10)
```

```
## # A tibble: 10 × 5
##       ID Preis Alter Preis_hat residual
##    <int> <dbl> <dbl>     <dbl>    <dbl>
##  1     1 10000  3.78    13094.   -3094.
##  2     2 21850  1.61    18813.    3037.
##  3     3 14500  2.28    17047.   -2547.
##  4     4 11100  5.33     9009.    2091.
##  5     5  6700  5.49     8587.   -1887.
##  6     6 24000  0.34    22161.    1839.
##  7     7 10000  4.31    11697.   -1697.
##  8     8 16900  1.69    18602.   -1702.
##  9     9 18000  2.53    16388.    1612.
## 10    10 15300  3.55    13700.    1600.
```

---
class: left

.blockquote[Bestimmtheitsmaß]

## Bestimmtheitsmaß in R:

* "Händisch"

```r
SSQ <- regression_points  %>% 
          summarise(TSS=sum((Preis-mean(Preis))^2),
                    SSR=sum(residual^2))
1-SSQ$SSR/SSQ$TSS
```

```
## [1] 0.8677253
```

* moderndive `get_regression_summaries()`

```r
get_regression_summaries(model) %>% pull(r_squared)
```

```
## [1] 0.868
```

---
class: left

.blockquote[Bestimmtheitsmaß]

## Bestimmtheitsmaß und Korrelationskoeffizient

* Das Bestimmtheitsmaß (auch Determinationskoeffizient) enstspricht der quadrierten Korrelation zwischen beobachtetem und vorhergesagtem Wert:

`$$\begin{equation*}
	R^2 = r_{y,\hat{y}}^2
\end{equation*}$$`

* Im Fall der linearen Einfachregression sind die vorhergesagten Werte `$(\hat{y})$` eine lineare Transformation des Regressors `$(\hat{y}=b_1+b_2x)$`

* Weil `$r$` invariant gegenüber linearen Transformationen der Variablen kann das Bestimmtheitsmaß im Fall der linearen Einfachregression (und nur in diesem Fall!) auch als quadrierte Korrelation zwischen Regressor und Regressand bestimmt werden:

`$$\begin{equation*}
	R^2=r_{x,y}^2
\end{equation*}$$`

* Beweis: vgl. [Stocker, Kap. 2, S. 37](https://www.uibk.ac.at/econometrics/einf/kap02_ols.pdf)

---
class: left

.blockquote[Ein kategorialer Regressor]

## Sonderfall Einfachregression

```r
tbl_autos %>% 
  summarise(r=cor(Preis,Alter),
            RSq=(cor(Preis,Alter)^2))
```

```
## # A tibble: 1 × 2
##        r   RSq
##    <dbl> <dbl>
## 1 -0.932 0.868
```

---
class: left

.blockquote[Ein kategorialer Regressor]

## Beispiel Lebenserwartung und Geografie

```
## Rows: 142
## Columns: 4
## $ country   <fct> "Afghanistan", "Albania", "Algeria", "Angola", "Argentina", …
## $ lifeExp   <dbl> 43.828, 76.423, 72.301, 42.731, 75.320, 81.235, 79.829, 75.6…
## $ continent <fct> Asia, Europe, Africa, Africa, Americas, Oceania, Europe, Asi…
## $ gdpPercap <dbl> 974.5803, 5937.0295, 6223.3675, 4797.2313, 12779.3796, 34435…
```

---
class: left

.blockquote[Ein kategorialer Regressor]

## Datenvisualisierung: Histogramme

.panelset[
.panel[.panel-name[Pooled]
<img src="data:image/png;base64,#02_DescriptiveRegression_files/figure-html/unnamed-chunk-21-1.png" width="50%" style="display: block; margin: auto;" />
]

.panel[.panel-name[Kontinente]
<img src="data:image/png;base64,#02_DescriptiveRegression_files/figure-html/unnamed-chunk-22-1.png" width="50%" style="display: block; margin: auto;" />
]
]

---
class: left

.blockquote[Ein kategorialer Regressor]

## Datenvisualisierung: Boxplot

---
class: left

.blockquote[Ein kategorialer Regressor]

## Deskriptive Statistiken

```r
lifeExp_by_continent <- gapminder2007 %>%
                        group_by(continent) %>%
                        summarise(median = median(lifeExp), 
                                  mean = mean(lifeExp))
lifeExp_by_continent
```

```
## # A tibble: 5 × 3
##   continent median  mean
##   <fct>      <dbl> <dbl>
## 1 Africa      52.9  54.8
## 2 Americas    72.9  73.6
## 3 Asia        72.4  70.7
## 4 Europe      78.6  77.6
## 5 Oceania     80.7  80.7
```

---
class: left

.blockquote[Ein kategorialer Regressor]

## Lineare Regression und Interpretation des Interzept-Terms

```r
lifeExp_model <- gapminder2007 %>% 
                      lm(lifeExp ~ continent, data = .)
get_regression_table(lifeExp_model)
```

```
## # A tibble: 5 × 7
##   term                estimate std_error statistic p_value lower_ci upper_ci
##   <chr>                  <dbl>     <dbl>     <dbl>   <dbl>    <dbl>    <dbl>
## 1 intercept               54.8      1.02     53.4        0     52.8     56.8
## 2 continent: Americas     18.8      1.8      10.4        0     15.2     22.4
## 3 continent: Asia         15.9      1.65      9.68       0     12.7     19.2
## 4 continent: Europe       22.8      1.70     13.5        0     19.5     26.2
## 5 continent: Oceania      25.9      5.33      4.86       0     15.4     36.4
```
<svg aria-hidden="true" role="img" viewBox="0 0 512 512" style="height:1em;width:1em;vertical-align:-0.125em;margin-left:auto;margin-right:auto;font-size:inherit;fill:currentColor;overflow:visible;position:relative;"><path d="M464 256A208 208 0 1 0 48 256a208 208 0 1 0 416 0zM0 256a256 256 0 1 1 512 0A256 256 0 1 1 0 256zm169.8-90.7c7.9-22.3 29.1-37.3 52.8-37.3h58.3c34.9 0 63.1 28.3 63.1 63.1c0 22.6-12.1 43.5-31.7 54.8L280 264.4c-.2 13-10.9 23.6-24 23.6c-13.3 0-24-10.7-24-24V250.5c0-8.6 4.6-16.5 12.1-20.8l44.3-25.4c4.7-2.7 7.6-7.7 7.6-13.1c0-8.4-6.8-15.1-15.1-15.1H222.6c-3.4 0-6.4 2.1-7.5 5.3l-.4 1.2c-4.4 12.5-18.2 19-30.6 14.6s-19-18.2-14.6-30.6l.4-1.2zM224 352a32 32 0 1 1 64 0 32 32 0 1 1 -64 0z"/></svg> Interpretation Intercept?

???

* **intercept corresponds** to the mean life expectancy of **countries in Africa** of 54.8 years.

* Warum Afrika als Referenz? You might be asking at this point why was Africa chosen as the “baseline for comparison” group. This is the case for no other reason than it **comes first alphabetically** of the five continents;

* kann entsprechend mit factor-Variable geändert werden!

* **continent: Americas** corresponds to countries in the Americas and the value +18.8 . Vgl. Folie vorher: 54.8+18.8=73.6

* **continent: Asia** corresponds to countries in Asia and the value +15.9. Vgl. Folie vorher: 54.8+15.9=70.7

* **continent: Europe** corresponds to countries in Europe and the value +22.8.  Vgl. Folie vorher: 54.8+22.8=77.6 .

* **continent: Oceania** corresponds to countries in Oceania and the value +25.9 is the same difference in mean life expectancy relative to Africa.  Vgl. Folie vorher: 
54.8+25.9=80.7.

---
class: inverse, center, middle

## Multiple (deskriptive) Regression

.blockquote[Ein kategorialer und ein numerischer Regressor]

.blockquote[Zwei numerische Regressoren]

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Lehrevaluation (moderndive): Daten UT Austin

```r
evals_ch6 <- evals %>%
                select(ID, score, age, gender)
glimpse(evals_ch6)
```

```
## Rows: 463
## Columns: 4
## $ ID     <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, …
## $ score  <dbl> 4.7, 4.1, 3.9, 4.8, 4.6, 4.3, 2.8, 4.1, 3.4, 4.5, 3.8, 4.5, 4.6…
## $ age    <int> 36, 36, 36, 36, 59, 59, 59, 51, 51, 40, 40, 40, 40, 40, 40, 40,…
## $ gender <fct> female, female, female, female, male, male, male, male, male, f…
```

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Lehrevaluation (moderndive): EDA

```r
evals_ch6 %>% select(score, age, gender) %>% skim() %>% yank("numeric")
```

**Variable type: numeric**

|skim_variable | n_missing| complete_rate|  mean|   sd|   p0|  p25|  p50|  p75| p100|hist  |
|:-------------|---------:|-------------:|-----:|----:|----:|----:|----:|----:|----:|:-----|
|score         |         0|             1|  4.17| 0.54|  2.3|  3.8|  4.3|  4.6|    5|▁▁▅▇▇ |
|age           |         0|             1| 48.37| 9.80| 29.0| 42.0| 48.0| 57.0|   73|▅▆▇▆▁ |

```r
evals_ch6 %>% 
  get_correlation(formula = score ~ age)
```

```
## # A tibble: 1 × 1
##      cor
##    <dbl>
## 1 -0.107
```

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Lehrevaluation (moderndive): EDA mittels Dataviz

.pull-left[

```r
ggplot(evals_ch6, aes(x = age, y = score, color = gender)) +
  geom_point() +
  labs(x = "Alter", y = "Bewertung", color = "Geschlecht") +
  geom_smooth(method = "lm", se = FALSE)
```
]
.pull-right[
![](data:image/png;base64,#02_DescriptiveRegression_files/figure-html/UTAustin-interaction-1.png)

]

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Lehrevaluation (moderndive):  Modell mit Interaktion

* Regressionsgleichung

`$$y=b_1+b_2\cdot \mbox{Alter}+b_3\cdot \mbox{Geschlecht}+ b_4\cdot \mbox{Alter}\cdot\mbox{Geschlecht}$$`
* Umsetzung in R:

```r
# Fit regression model:
score_model_interaction <-  evals_ch6 %>% 
                                lm(score ~ age * gender, data = .)
```

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

##  Modell mit Interaktion: Ergebnisse und Interpretation

```r
# Get regression table:
get_regression_table(score_model_interaction)
```

```
## # A tibble: 4 × 7
##   term           estimate std_error statistic p_value lower_ci upper_ci
##   <chr>             <dbl>     <dbl>     <dbl>   <dbl>    <dbl>    <dbl>
## 1 intercept         4.88      0.205     23.8    0        4.48     5.29 
## 2 age              -0.018     0.004     -3.92   0       -0.026   -0.009
## 3 gender: male     -0.446     0.265     -1.68   0.094   -0.968    0.076
## 4 age:gendermale    0.014     0.006      2.45   0.015    0.003    0.024
```
--
* Vergleichsgruppe?
--

| Geschlecht | Achsenabschnitt | Steigung Alter |
|------------|:---------------:|:--------------:|
| weiblich   |      4.883      |     -0.018     |
| männlich   |      4.437      |     -0.004     |

???

* Betrachtet man die Ausgabe der Regressionstabelle, so findet man in der 
  * Spalte Schätzung vier Zeilen mit Werten. Auch wenn es nicht sofort ersichtlich ist, können wir mit Hilfe dieser vier Werte die Gleichungen der beiden Linien im Streudiagramm aufstellen.

* Erstens: Da das Wort "weiblich" (female!) in der alphabetischen Reihenfolge vor "männlich" (male) steht, sind **weibliche Lehrkräfte die "Vergleichsgruppe"**. 
  
 * Mithin Dummy-Variable (0=weiblich, 1=männlich)
    * Daher ist der Achsenabschnitt nur für die weiblichen Lehrkräfte.
    * Dies gilt in ähnlicher Weise für das **Alter**. Es ist die **Steigung** für das Alter **nur für die weiblichen** Lehrkräfte. 
    * Somit hat die **rote Regressionslinie** im Streudiagramm: 
        * Achsenabschnitt von 4,883 und eine 
        * Steigung für das Alter von -0,018.
        
* Obs! **Achsenabschnitt** hat zwar eine mathematische/geometrische, aber **keine praktische/inhaltliche Bedeutung** hat, da das Alter der Ausbilder nicht gleich Null sein kann.
* Was ist mit dem Achsenabschnitt und der Steigung für das Alter der **männlichen Ausbilder** (**blaue Linie im Streudiagramm)? 
  * "Offsets": Der Wert für Geschlecht: männlich von -0,446 ist nicht der Achsenabschnitt für die männlichen Ausbilder, sondern der Offset des Achsenabschnitts für männliche Ausbilder im Verhältnis zu den weiblichen Ausbildern.
   * Somit Intercept für die männlichen Lehrkräfte ist intercept + gender: male = 4,883 + (-0,446) = 4,883 - 0,446 = 4,437.
   * Ähnlich: age:gendermale = 0,014 nicht die Steigung für das Alter der männlichen Ausbilder, sondern die Verschiebung der Steigung für die männlichen Ausbilder. Daher ist die **Steigung für das Alter der männlichen Ausbilder Alter + Alter:Geschlecht =-0,018+0,014=-0,004=-0,018+0,014=-0,004**. 
   * Somit hat die **blaue Regressionslinie** im Streudiagramm hat einen Achsenabschnitt von 4,437 und eine Steigung für das Alter von -0,004.

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Lehrevaluation (moderndive): Modell ohne Interaktion

* Regressionsgleichung

`$$y=b_1+b_2\cdot \mbox{Alter}+b_3\cdot \mbox{Geschlecht}$$`

```r
# Fit regression model:
score_model_parallel_slopes <- lm(score ~ age + gender, data = evals_ch6)
# Get regression table:
get_regression_table(score_model_parallel_slopes)
```

```
## # A tibble: 3 × 7
##   term         estimate std_error statistic p_value lower_ci upper_ci
##   <chr>           <dbl>     <dbl>     <dbl>   <dbl>    <dbl>    <dbl>
## 1 intercept       4.48      0.125     35.8    0        4.24     4.73 
## 2 age            -0.009     0.003     -3.28   0.001   -0.014   -0.003
## 3 gender: male    0.191     0.052      3.63   0        0.087    0.294
```

???

* Referenz wieder weiblich

* männlicher Achsenabschnitt: 4,484+0,191=4,675

| Geschlecht | Achsenabschnitt | Steigung Alter |
|------------|:---------------:|:--------------:|
| weiblich   |      4.484      |     -0.009     |
| männlich   |      4.675      |     -0.009     |

???

* Wichtig: Die Regressionsgeraden folgen hier nicht aus den Daten sondern sind die Folge einer Modellannahme (gleiche Steigungen)

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Modell ohne Interaktion (Parallel Slopes)

.pull-left[

```r
ggplot(evals_ch6, aes(x = age, y = score, color = gender)) +
  geom_point() +
  labs(x = "Age", y = "Bewertung", color = "Geschlecht") +
  geom_parallel_slopes(se = FALSE)
```
]
.pull-right[
![](data:image/png;base64,#02_DescriptiveRegression_files/figure-html/UTAustin-parallelslopes-1.png)
]

???

Modellannahme Parallel slopes

Zwei Varianten zur Konstruktion der Abbildung, vgl. [Wolf Riepl](https://www.youtube.com/watch?v=ntrjjNXNJCY)

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Lehrevaluation (moderndive): Vergleich der Modelle

.pull-left[
<img src="data:image/png;base64,#02_DescriptiveRegression_files/figure-html/unnamed-chunk-34-1.png" width="100%" style="display: block; margin: auto;" />
]
.pull-right[
<img src="data:image/png;base64,#02_DescriptiveRegression_files/figure-html/unnamed-chunk-35-1.png" width="100%" style="display: block; margin: auto;" />

]

???

* Was spricht für parallel slope? Einfachheit!
* Die Antwort liegt in einem philosophischen Grundsatz, der als "Occam's Razor" bekannt ist. Es besagt, dass "unter sonst gleichen Bedingungen einfachere Lösungen wahrscheinlicher sind als komplexe". In Bezug auf die Modellierung lässt sich Occams Razor wie folgt umformulieren: **"Unter sonst gleichen Bedingungen sind einfachere Modelle komplexen vorzuziehen."** Mit anderen Worten: Wir sollten das komplexere Modell nur dann bevorzugen, wenn die zusätzliche Komplexität gerechtfertigt ist.

* "Lässt sich die zusätzliche Komplexität des Interaktionsmodells rechtfertigen?"
  * In diesem Fall kann man argumentieren, dass diese zusätzliche Komplexität gerechtfertigt ist, wie das eindeutige x-förmige Muster der beiden Regressionslinien in der linken Grafik zeigt

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Schulen MA: Wahl eines Modells

* Beispiel Schulergebnisse in Massachussetts

* Variablen:
  * Regressand: SAT-Score
  * metrischer Regressor: Anteil wirtschaftlich benachteiligter Schüler
  * kategorialer Regresor: Schulgröße (klein, mittel groß)

???

* Betrachten wir jedoch ein Beispiel, bei dem die zusätzliche Komplexität möglicherweise nicht gerechtfertigt ist.

* Betrachten wir die MA_schools-Daten, die im moderndive-Paket enthalten sind und 2017 Daten zu öffentlichen High Schools in Massachusetts enthalten, die vom Massachusetts Department of Education bereitgestellt werden. Weitere Einzelheiten finden Sie in der Hilfedatei für diese Daten, indem Sie ?MA_schools in der Konsole ausführen.

* Modellieren wir die numerische Ergebnisvariable y, die durchschnittliche SAT-Mathe-Punktzahl für eine bestimmte High School, als

* Funktion von zwei erklärenden Variablen:
  * Eine numerische erklärende Variable x1, der Prozentsatz der Schülerschaft dieser High School, die wirtschaftlich benachteiligt sind, und
  * eine kategoriale erklärende Variable x2, die Schulgröße, gemessen an der Schülerzahl: klein (13-341 Schüler), mittel (342-541 Schüler) und groß (542-4264 Schüler).

* Erstellen wir noch einmal Visualisierungen sowohl des Interaktions- als auch des parallelen Steigungsmodells und zeigen die Ergebnisse in Abbildung 6.8. Erinnern Sie sich an Unterabschnitt 6.1.3, dass die Funktion geom_parallel_slopes() eine spezielle Funktion des Pakets moderndive ist, da die Methode geom_smooth() des Pakets ggplot2 keine bequeme Möglichkeit zur Darstellung von Modellen mit parallelen Steigungen bietet.

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Schulen MA: Datenvisualisierung Modelle und "Eyeball-Test"

.pull-left[

]
.pull-right[

<img src="data:image/png;base64,#02_DescriptiveRegression_files/figure-html/unnamed-chunk-37-1.png" width="100%" style="display: block; margin: auto;" />
]

???

* left plot: While the **slopes** are indeed different, they **do not differ by much and are nearly identical**. Now compare the left-hand plot with the right-hand plot corresponding to a parallel slopes model. The **two models don’t appear all that different.**

* So in this case, it **can be argued** that the additional complexity of the **interaction model is not warranted**.

* **"Eyeball-Test"** als qualitative Betrachtung von Visualisierungen zur Auswahl eines Modells:
  * ermöglicht **rudimentäre Vorauswahl** der Modelle 
  * Auswahl des Modells, das am besten zu den Daten passt, aus einer Reihe von Modellkandidaten.

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Schulen MA: Koeffizienten der Modelle

.pull-left[

```r
model_2_interaction <- lm(average_sat_math ~ perc_disadvan * size, 
                          data = MA_schools)
get_regression_table(model_2_interaction) %>% 
                          select(term, estimate)
```

```
## # A tibble: 6 × 2
##   term                     estimate
##   <chr>                       <dbl>
## 1 intercept                 594.   
## 2 perc_disadvan              -2.93 
## 3 size: medium              -17.8  
## 4 size: large               -13.3  
## 5 perc_disadvan:sizemedium    0.146
## 6 perc_disadvan:sizelarge     0.189
```
]
--
.pull-right[

```r
model_2_parallel_slopes <- lm(average_sat_math ~ perc_disadvan + size, 
                              data = MA_schools)
get_regression_table(model_2_parallel_slopes) %>% 
                          select(term, estimate)
```

```
## # A tibble: 4 × 2
##   term          estimate
##   <chr>            <dbl>
## 1 intercept       588.  
## 2 perc_disadvan    -2.78
## 3 size: medium    -11.9 
## 4 size: large      -6.36
```

]

???

* Eyeball Test in Zahlen durch Vergleich der numerischen Koeffizienten

* Zunächst fällt auf
  * Regressionstabelle für das Interaktionsmodell hat 2 Zeilen mehr (6 vs. 4). 
  * Dies spiegelt die **zusätzliche "Komplexität" des Interaktionsmodells** gegenüber dem Modell mit parallelen Steigungen wider.

* Bzgl. der Koeffizienten sehen wir, dass die **Offsets** für die Steigungen *perc_disadvan:sizemedium* (0,146) und *perc_disadvan:sizelarge* (0,189) **im Vergleich zur Steigung für die Basisgruppe** der kleinen Schulen von -2,932 **gering** sind.

* Mit anderen Worten: Alle drei Steigungen sind ähnlich negativ:
  * -2,932 für kleine Schulen, 
  * -2,786(=-2,932+0,146) für mittlere Schulen und
  * -2,743(=-2,932+0,189) für große Schulen. 
  
* Damit deuten die Ergebnisse darauf hin, dass unabhängig von der Schulgröße die Beziehung zwischen den durchschnittlichen SAT-Ergebnissen in Mathematik und dem Anteil der wirtschaftlich benachteiligten Schülerschaft ähnlich ist - gesellschaftlich gesehen leider ziemlich negativ

* Eyeball-Test zwar intuitiv überzeugend, aber wir würden es gern mit Kennzahlen untermauern. Dazu können wir das Bestimmtheitsmaß nutzen (sprich "R-Quadrat").

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Schulen MA: Vergleich Bestimmtheitsmaße

.pull-left[

```r
model_2_interaction %>% 
  get_regression_points() %>% 
          select(average_sat_math,residual) %>% 
          summarise(TSS=sum((average_sat_math-mean(average_sat_math))^2),
                    SSR=sum(residual^2),
                    RSq=1-SSR/TSS)
```

```
## # A tibble: 1 × 3
##        TSS     SSR   RSq
##      <dbl>   <dbl> <dbl>
## 1 1221806. 367669. 0.699
```
]
.pull-right[

```r
model_2_parallel_slopes %>% 
  get_regression_points() %>% 
          select(average_sat_math,residual) %>% 
          summarise(TSS=sum((average_sat_math-mean(average_sat_math))^2),
                    SSR=sum(residual^2),
                    RSq=1-SSR/TSS)
```

```
## # A tibble: 1 × 3
##        TSS     SSR   RSq
##      <dbl>   <dbl> <dbl>
## 1 1221806. 368058. 0.699
```
]

???

* RSq identisch? Nicht ganz, wie wir an den unterschiedlichen SSR sehen

* genau ist `$R^2$`
  * im Interaktionmodell und 0.6990772	
  * im Parallel Slopes Modell 0.6987588

* also im Fall des Interaktionsmodells minimal höher.

* Berücksichtigen wir aber, dass im Interaktionsmodell zwei Regressoren mehr benutzt werden, spricht das für das Modell ohne Interaktion (Einfachheit, Parsimony)

* Auch dies lässt sich objektivieren. Tatsächlich steigt das `$R^2$` immer mit zunehmender Zahl an Regressoren, deshalb macht es Sinn, das Bestimmtheitsmaß diesbezüglich anzupassen: `$R^2$`-adjusted

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Schulen MA: Modellwahl auf Basis `$R^2$`-Adjusted

.pull-left[

```r
model_2_interaction %>% 
  get_regression_summaries() %>% 
      select(r_squared, adj_r_squared)
```

```
## # A tibble: 1 × 2
##   r_squared adj_r_squared
##       <dbl>         <dbl>
## 1     0.699         0.694
```
]
.pull-right[

```r
model_2_parallel_slopes %>% 
  get_regression_summaries() %>% 
      select(r_squared, adj_r_squared)
```

```
## # A tibble: 1 × 2
##   r_squared adj_r_squared
##       <dbl>         <dbl>
## 1     0.699         0.696
```
]

???

* Tatsächlich ist das `$R^2$`-adjusted im Parallel slopes model leicht höher

* Wie sieht es in unserem Beispiel Lehrevaluation aus?

---
class: left

.blockquote[Ein kategorialer und ein numerischer Regressor]

## Beispiel Schulen MA: Modellwahl auf Basis `$R^2$`-Adjusted

.pull-left[

```r
score_model_interaction %>% 
  get_regression_summaries() %>% 
      select(r_squared, adj_r_squared)
```

```
## # A tibble: 1 × 2
##   r_squared adj_r_squared
##       <dbl>         <dbl>
## 1     0.051         0.045
```
]
.pull-right[

```r
score_model_parallel_slopes %>% 
  get_regression_summaries() %>% 
      select(r_squared, adj_r_squared)
```

```
## # A tibble: 1 × 2
##   r_squared adj_r_squared
##       <dbl>         <dbl>
## 1     0.039         0.035
```
]

???

* hier ist tatsächlich das Interaktionsmodell "besser"!

TODO: Zwei numerische Regressoren

---
class: left

.blockquote[Zwei numerische Regressoren]

## Beispiel Kreditkartendaten

.panelset[
.panel[.panel-name[Modell]
* Modell: 
  * Eine numerische Ergebnisvariable `$y$`: Kreditkartenschulden des Karteninhabers
  * Zwei erklärende Variablen:
    * Erste numerische erklärende Variable `$x1$`: Kreditlimit des Karteninhabers
    * Zweite numerische erklärende Variable `$x2$`: Einkommen des Karteninhabers
    
* Daten aus [An Introduction to Statistical Learning with Applications in R (ISLR)](https://www.statlearning.com/) im R-Paket `ISLR`

* Im Lehrbuch werden mit den Daten diverse Machine Learning Modelle erarbeitet
]
.panel[.panel-name[Daten]

```r
#install.packages("ISLR") #ggf. Paket installieren
library(ISLR)
# Datensatz laden und Variablen auswählen ----
credit_ch6 <- Credit %>% as_tibble() %>% 
  select(ID, debt = Balance, credit_limit = Limit, 
         income = Income, credit_rating = Rating, age = Age)
glimpse(credit_ch6)
```

```
## Rows: 400
## Columns: 6
## $ ID            <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1…
## $ debt          <int> 333, 903, 580, 964, 331, 1151, 203, 872, 279, 1350, 1407…
## $ credit_limit  <int> 3606, 6645, 7075, 9504, 4897, 8047, 3388, 7114, 3300, 68…
## $ income        <dbl> 14.891, 106.025, 104.593, 148.924, 55.882, 80.180, 20.99…
## $ credit_rating <int> 283, 483, 514, 681, 357, 569, 259, 512, 266, 491, 589, 1…
## $ age           <int> 34, 82, 71, 36, 68, 77, 37, 87, 66, 41, 30, 64, 57, 49, …
```

]
]

---
class: left

.blockquote[Zwei numerische Regressoren]

## Beispiel Kreditkartendaten: Zusammenfassende Statistiken

```r
skim <- credit_ch6 %>% select(debt, credit_limit, income) %>% skim()
skim %>% yank("numeric")
```

**Variable type: numeric**

|skim_variable | n_missing| complete_rate|    mean|      sd|     p0|     p25|     p50|     p75|     p100|hist  |
|:-------------|---------:|-------------:|-------:|-------:|------:|-------:|-------:|-------:|--------:|:-----|
|debt          |         0|             1|  520.02|  459.76|   0.00|   68.75|  459.50|  863.00|  1999.00|▇▅▃▂▁ |
|credit_limit  |         0|             1| 4735.60| 2308.20| 855.00| 3088.00| 4622.50| 5872.75| 13913.00|▆▇▃▁▁ |
|income        |         0|             1|   45.22|   35.24|  10.35|   21.01|   33.12|   57.47|   186.63|▇▂▁▁▁ |

???

* Kennzahlen besprechen

---
class: left

.blockquote[Zwei numerische Regressoren]

## Beispiel Kreditkartendaten: Streudiagramm-Matrix

```r
credit_ch6 %>% select(debt, credit_limit, income) %>% GGally::ggpairs()
```

???

* Sehr hohe Korrelation zwischen den Regressoren (Einkommen und Kreditlimit): 0,792

* Wir sagen, dass ein **hohes Maß an Kollinearität** zwischen den erklärenden Variablen Kredit_Limit und Einkommen besteht. Kollinearität (oder Multikollinearität) ist ein Phänomen, bei dem eine erklärende Variable in einem multiplen Regressionsmodell stark mit einer anderen korreliert ist.

* Diese beiden Variablen liefern also gewissermaßen **redundante Informationen**. Die Erörterung der Arbeit mit kollinearen erklärenden Variablen überlassen wir jedoch einem Buch über Regressionsmodellierung auf mittlerem Niveau.

* Hierzu mehr in Teil 3

---
class: left

.blockquote[Zwei numerische Regressoren]

## Beispiel Kreditkartendaten: Dataviz Regressionsmodell (Partialbetrachtung)

.pull-left[
<img src="data:image/png;base64,#02_DescriptiveRegression_files/figure-html/unnamed-chunk-49-1.png" width="100%" style="display: block; margin: auto;" />
]

.pull-right[
<img src="data:image/png;base64,#02_DescriptiveRegression_files/figure-html/unnamed-chunk-50-1.png" style="display: block; margin: auto;" />
]

---
class: left

.blockquote[Zwei numerische Regressoren]

## Beispiel Kreditkartendaten: Regressionsmodel

* Modellspezifikation

```r
debt_model <- lm(debt ~ credit_limit + income, data = credit_ch6)
```

* Koeffizienten

```r
get_regression_table(debt_model) %>% 
            select(term, estimate)
```

```
## # A tibble: 3 × 2
##   term         estimate
##   <chr>           <dbl>
## 1 intercept    -385.   
## 2 credit_limit    0.264
## 3 income         -7.66
```

???

Interpretation

* Interzept: -385.179USD. 
  * Dieser Abschnittswert stellt die Kreditkartenschulden einer Person dar, die ein Kreditlimit von 0 USD und ein Einkommen von 0 USD hat. 
  * In unseren Daten hat der Abschnittswert jedoch **keine praktische Bedeutung**, da keine Person ein Kreditlimit oder ein Einkommen von 0USD hat. 
  * Abschnittswert ist eine technische Größe - dient dazu, die Regressionsebene im 3D-Raum zu verorten.
  * Stellt Unverzerrtheit des Schätzers sicher (vgl. Teil 3)
  
* Koeffizient **credit_limit**: 0,264 USD.
  * Bei Konstanz aller anderen erklärenden Variablen in unserem Modell, also **ceteris paribus** führt jeder **Anstieg des Kreditlimits um einen Dollar** zu einem *Anstieg der Kreditkartenschulden* um **durchschnittlich 0,26 Dollar.**
  * Obs! Ohne Theorie können wir hier **keine Kausalität unterstellen** (Korrelation vs. Kausalität, vgl. Teil 1) 
  * Wir stellen lediglich fest, dass es **im Durchschnitt** einen entsprechenden Anstieg gab.
  * ceteris paribus: Wir tun dies, um zu betonen, dass wir nun den damit verbundenen Effekt mehrerer erklärender Variablen im selben Modell gleichzeitig interpretieren.

* Koeffizient **Einkommen**: -7,66USD. ceteris paribus ergibt sich für jede Erhöhung des Einkommens um eine Einheit (also 1000 USD tatsächliches Einkommen) eine **Verringerung der Kreditkartenschulden um durchschnittlich 7,66 USD**.

---
class: left

.blockquote[Zwei numerische Regressoren]

## Beispiel Kreditkartendaten: Regressionsmodel

`$$\begin{eqnarray}\hat{y_i}&=&b_0+b_1\cdot x_{1,i}+b_2\cdot x_{2,i}\\
\widehat{\mbox{Schulden_i}}&=&b_0 + b_{\mbox{limit}}\cdot \mbox{limit}+b_{\mbox{Einkommen}}\cdot \mbox{Einkommen}\\
&=&-385.179+0.263\cdot\mbox{Limit}-7.663\cdot\mbox{Einkommen}\\
\end{eqnarray}$$`

* Erklärung: Simpson's Paradoxon

???

Widerspruch: in der Grafik war die Steigung von Einkommen positiv

Erklärung: Simpson's paradoxon

Gesamttrends, die im Aggregat bestehen, entweder verschwinden oder sich umkehren, wenn die Daten in Gruppen unterteilt werden. In Unterabschnitt 6.3.4 wird dieser Gedanke weiter ausgeführt, indem die Beziehung zwischen Kreditlimit und Kreditkartenverschuldung untersucht wird, allerdings unterteilt nach verschiedenen Einkommensgruppen.

Mit anderen Worten: Während die Beziehung zwischen Schulden und Einkommen isoliert betrachtet positiv sein mag, wird diese Beziehung negativ, wenn auch das Kreditlimit berücksichtigt wird. Diese scheinbar paradoxen Ergebnisse sind auf ein Phänomen zurückzuführen, das treffend als Simpson-Paradoxon bezeichnet wird. Das Simpson-Paradoxon tritt auf, wenn Trends, die für die Gesamtheit der Daten bestehen, entweder verschwinden oder sich umkehren, wenn die Daten in Gruppen aufgeteilt werden.

---
class: left

.blockquote[Zwei numerische Regressoren]

## Simpon's Paradoxon und Störvariable

.panelset[
.panel[.panel-name[Idee]
.blockquote[
Gesamttrends, die im Aggregat bestehen können verschwinden oder sich umkehren, wenn die Daten in Gruppen unterteilt werden.
]

* Verteilung der Kreditlimits

<img src="data:image/png;base64,#https://moderndive.com/ModernDive_files/figure-html/credit-limit-quartiles-1.png" width="100%" style="display: block; margin: auto;" />
]
.panel[.panel-name[Dataviz]

???

* Die **vertikalen gestrichelten Linien sind die Quartile**, die die Variable credit_limit in vier gleichgroße Gruppen unterteilen. Betrachten wir diese Quartile als Umwandlung unserer numerischen Variable credit_limit in eine kategoriale Variable "credit_limit bracket" mit vier Stufen. Dies bedeutet, dass
  * 25% der Kreditlimits lagen zwischen 0 und 3088. Ordnen wir diese 100 Personen dem "niedrigen" Kreditlimitbereich zu.
  * 25 % der Kreditlimits lagen zwischen 3088 und 4622. Ordnen wir diese 100 Personen der Gruppe der "mittel-niedrigen" Kreditlimits zu.
  * 25 % der Kreditlimits lagen zwischen 4622 und 5873. Ordnen wir diese 100 Personen der Gruppe der "mittelhohen" Kreditlimits zu.
  * 25 % der Kreditlimits lagen über 5873 $. Ordnen wir diese 100 Personen der Gruppe "hohe" Kreditlimits zu.

* PANEL WECHSELN

* Links das bekannte Streudiagramm (aggregierte Betrachtung)
* rechts ein **disaggregiertes Streudiagramm**, das die Regressionen nach Quartilen berechnet

Mit anderen Worten, die Lage der 400 Punkte ist in beiden Streudiagrammen gleich, aber das rechte Diagramm zeigt eine zusätzliche Informationsvariable: die Klammer credit_limit.

* In der rechten Grafik ist zu erkennen, dass die 
  * Beziehung zwischen Schulden und Einkommen für die "mittel-niedrigen" und "mittel-hohen" Kreditlimiten eindeutig negativ ist,
  * während die Beziehung **für die "niedrige" Kreditlimitengruppe eher flach** ist. 
  * Der **einzige Kreditlimitbereich**, in dem die Beziehung **positiv** bleibt, ist der **"hohe" Kreditlimitbereich**.

* Diese Beziehung ist jedoch **weniger positiv als die Beziehung insgesamt** (aggregiert), da die Steigung flacher ist als die Steigung der Regressionslinie in der linken Grafik.

* In diesem Beispiel des Simpson'schen Paradoxons ist **credit_limit eine Störvariable** für die Beziehung zwischen Kreditkartenschulden und Einkommen!

Daher **muss das Kreditlimit in jedem geeigneten Modell** für die Beziehung zwischen Schulden und Einkommen **berücksichtigt werden**.

---
class: inverse,center,middle

# Wir brauchen eine Pause.

---

background-image: url("data:image/png;base64,#http://bit.ly/cs631-donkey")
background-size: 80%

---
class: left

## Quellenverzeichnis

.ref-slide[
<a name=bib-stocker_grundlagen_nodate></a>[Stocker,
H.](#cite-stocker_grundlagen_nodate) "Grundlagen Der Deskriptiven
Regressionsanalyse - OLS Mechanik". Innsbruck.

<a name=bib-stoetzer_regressionsanalyse_2020></a>[Stoetzer,
M.](#cite-stoetzer_regressionsanalyse_2020) (2020b).
_Regressionsanalyse in der empirischen Wirtschafts- und Sozialforschung
Band 2: Komplexe Verfahren_. Berlin, Heidelberg: Springer Berlin
Heidelberg. ISBN: 978-3-662-61437-2. (Visited on Apr. 14, 2024).
]